home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / modula.arc / LIST2.MOD < prev    next >
Encoding:
Text File  |  1985-05-30  |  1.4 KB  |  72 lines
  1. MODULE list;
  2.  
  3. FROM InOut   IMPORT Write, WriteLn, WriteString, ReadCard, WriteCard;
  4. FROM Storage IMPORT ALLOCATE;
  5.  
  6. TYPE ref = POINTER TO word;
  7.      word = RECORD
  8.               key: CARDINAL;
  9.               count:CARDINAL;
  10.               next: ref
  11.             END;
  12.  
  13. VAR k: CARDINAL;
  14.     root,sentinel: ref;
  15.  
  16. PROCEDURE search(x: CARDINAL; VAR root: ref);
  17. VAR w1,w2,w3: ref;
  18.  
  19. BEGIN
  20.   w1 := root;
  21.   sentinel^.key := x;
  22.   IF w1 = sentinel THEN
  23.     NEW(root);
  24.     WITH root^ DO
  25.       key := x;
  26.       count := 1;
  27.       next := sentinel
  28.     END
  29.   ELSIF w1^.key = x THEN
  30.     INC(w1^.count);
  31.   ELSE
  32.     REPEAT w2 := w1; w1 := w2^.next UNTIL w1^.key =x;
  33.     IF w1 = sentinel THEN
  34.       w2 := root;
  35.       NEW(root);
  36.       WITH root^ DO
  37.         key := x;
  38.         count := 1;
  39.         next := w2
  40.       END
  41.     ELSE
  42.       INC(w1^.count);
  43.       w2^.next := w1^.next;
  44.       w1^.next := root;
  45.       root := w1
  46.     END
  47.   END
  48. END search;
  49.  
  50. PROCEDURE printlist(w,z: ref);
  51. BEGIN
  52.   WriteString('    Key  Count');
  53.   WriteLn;
  54.   WHILE w # z DO
  55.     WriteCard(w^.key,6);
  56.     WriteCard(w^.count,6);
  57.     w := w^.next; WriteLn
  58.   END
  59. END printlist;
  60.  
  61. BEGIN
  62.   NEW(sentinel);
  63.   root := sentinel;
  64.   LOOP
  65.     WriteString(' Enter k> ');
  66.     ReadCard(k); WriteLn;
  67.     IF k = 0 THEN EXIT END;
  68.     search(k,root);
  69.   END;
  70.   printlist(root,sentinel)
  71. END list.
  72.